Projets Actuariat-Vie Sujet 3 :
Tarification d’une rente viagère et projection de la mortalité par le modèle de Lee-Carter

4 DS 9

Dans ce projet,On se propose d’estimer et de projeter la mortalité de deux cohortes d’assurés britanniques afin de calculer la valeur actuelle probable d’un produit de rente viagère à termes anticipés. La rente étant de 10 000 euros par an,payée au 31 décembre.

Installation des packages :

#install.packages("StMoMo")
#install.packages("forecast")
#install.packages("demography")

Chargement des packages :

library("demography")
library("forecast")

Choix des données à partir de Human Mortality Database :

#United Kingdom
# -- UK Total Population    GBR_NP
# -- England & Wales Total Population   GBRTENW
# -- England & Wales Civilian Population    GBRCENW
# -- Scotland   GBR_SCO
# -- Northern Ireland   GBR_NIR

En utilisant la commande hmd.mx() : label U.K : “GBR_NP” #### hmd.mx : lit les données “Mx” (1x1) de la base de données sur la mortalité humaine et construit un objet demogdata #### hmd.pop : lit les données “Population” (1x1) du HMD et construit un objet demogdata

DEATH = hmd.mx("GBR_NP", username="alikhemakhem01@gmail.com",password="Alikh220901*", label = "les taux démographiques - United Kingdom")
EXPOSURE = hmd.pop("GBR_NP", username="alikhemakhem01@gmail.com",password="Alikh220901*", label = "les numéros de population - United Kingdom")
demogUK <- read.demogdata(file="Mx_1x1.txt", 
                           popfile="Exposures_1x1.txt",
                           type="mortality", label="United Kingdom Total Population")

Manipulation des données HMD télécharger :

class(demogUK) # type vérifié

[1] "demogdata"

names(demogUK)

[1] "type"   "label"  "lambda" "year"   "age"    "rate"   "pop"   

résumé :

summary(demogUK)

Mortality data for United Kingdom Total Population
    Series: female male total
    Years: 1922 - 2021
    Ages:  0 - 110 

Pour le Royaume-Uni, la série de mortalité commence en 1922, donc nous pouvons montrer et afficher les taux de mortalité pour la cohorte féminine nés en 1960 pour les 60 ans . Les taux de mortalité par cohorte aux plus jeunes âges sont indiqués comme manquants (notés “.”). De même, la série de mortalité se termine en 2021, nous pouvons montrer les taux de mortalité pour la cohorte de 1960 jusqu’à 29 ans car au 31 décembre 2021, tous les membres de cette cohorte ont atteint l’âge de 61 ans. Pourtant, les données de mortalité pour 61 ans resteront incomplètes jusqu’au 31 décembre 2022.

### Affichage des objets demogdata :
#### 1)En fonction de l’ages en axes des abscisses

graphe taux de mortalité de la polpulation féminine en fonction de l’age :

####par(mar=c(1, 1, 1, 1 ), xpd=TRUE)

plot(demogUK, series = 'female')
## avec légendes des années  
legend("bottomright",legend=unique(demogUK$year),
       col=rainbow(length(demogUK$year)*1.25), ncol=5, pch=3, 
       title="Year", cex=0.6 )

Les lignes forment une courbe en forme de U, indiquant des taux de mortalité plus élevés aux âges plus jeunes et plus avancés. Cela suggère que les taux de mortalité sont généralement plus élevés pour les nouveau-nés et les personnes très âgées par rapport à la mortalité totale par âge.

Affichage ‘femme’ VS ‘total’ en fonction de l’age :

#par(mar=c(1, 1, 1, 1 ), xpd=TRUE)

par(mfrow=c(1,3))
plot(demogUK,series="male",datatype="rate", main="Taux d'hommes")
plot(demogUK,series="female",datatype="rate", main="Taux de femmes")

plot(demogUK,"total",datatype="rate", main="Taux total")

Pour la population anglaise , ces graphes présentent les 3 schémas du logarithme des taux de mortalité en fonction de lâge . On remarque plusieurs comportements , on constate que :

Les femmes sont également épargnées du pic de mortalité que la courbe rencontrée chez les hommes à la sortie de l’adolescence. Cela est probablement dû au fait que les normes culturelles imposent souvent aux hommes une tendance à prendre plus de risques pour s’affirmer à la sortie de l’adolescence . #taux de mortalité pour les années extemes :

# pour l'année 1960 :
plot(demogUK$age, log(demogUK$rate$female[,"1960"]), main ='Femme log taux de mortalité  (demogUK, 1960)',
     xlab = "Ages x", ylab = "Femme log taux de mortalité", type = "l", col = "red")

# pour l'année 2020 :
plot(demogUK$age, log(demogUK$rate$female[,"2020"]), main ='Femme log taux de mortalité (demoUK, 2020)',
     xlab = "Ages x", ylab = "Femme log taux de mortalité", type = "l", col = "red")

taux de mortalité pendant la 2éme guerre mondiale () :

UK_years = c(1939:1945)
plot(demogUK, series = 'female', years = UK_years ,
     main = "demogUK female taux de mortalité entre les années 1939 à 1945"
     )
legend(x="bottomright", legend = UK_years,
       col = rainbow(length(UK_years)*1.25),
       lty = 1,
       cex=0.7,
       box.lwd = 0.3
       )

Affichage des objets demogdata :

2)En fonction des années en axes des abscisses

taux de mortalité entre les années 1960 au 2020 :

UK_years = c(1960:2020)
par(mar=c(1, 1, 1, 1 ), xpd=TRUE)
plot(demogUK, series = 'female', years = UK_years ,
     main = "demogUK female taux de mortalité entre les années 1960 à 2020"
     )
colfunc <- colorRampPalette(c("red", "blue"))
legend(legend=unique(demogUK$year),
       col=colfunc(20), ncol=5, pch=19, 
       title="Year", cex=0.6, "bottomright")

graphe taux de mortalité de la polpulation féminine en fonction des années :

plot(demogUK,series="female",datatype="rate", main="Taux de femmes",plot.type="time",xlab="Age")
legend(legend=unique(demogUK$age),
       col=colfunc(20), ncol=20, pch=19, 
       title="Age", cex=0.4, "bottomright")

#install.packages("plotly")
#library(plotly)

observation population féminine :

on remarque que les taux de mortalité sont les plus élevés pour les personnes âgés : colorés en mauve et ene bleu (au dessus) > 84 ans , ainsi que les nouveaux nées entre 0 et 3 ans , qui diminue au cours des années . on remarque que les taux de mortalité sont les moins élevés pour les personnes jeunes : colorés en orangé (au dessous) ente 20 ans et 24 ans qui diminue au cours des années .

Le log des taux de mortalité en fonction de l’âge et en fonction des années en 3D :

demogUKlog = as.matrix(log(demogUK$rate$total))
demogUKlog[is.infinite(demogUKlog)]<-NA
library(ggplot2)
library(plotly)

Attachement du package : ‘plotly’

L'objet suivant est masqué depuis ‘package:ggplot2’:

    last_plot

L'objet suivant est masqué depuis ‘package:stats’:

    filter

L'objet suivant est masqué depuis ‘package:graphics’:

    layout

p <- plot_ly(z = ~demogUKlog ) %>% add_surface()
p

==>Le comportement des taux de mortalité reste quasi constants durants toutes les années on va prendre en considération tous les années 1922 -to- 2021 ,t ∈ [1922, 2021]

Question 2 :

Estimer les paramètres d’un modèle de Lee-Carter à partir des données historiques téléchargées (on pourra utiliser la fonction fit du package StMoMo). On prendra bien soin de : • Commenter/justifier le choix de la plage d’âge et de la période choisie pour calibrer les données (on pourra les faire varier). • Commenter les résultats obtenus en affichant les paramètres estimés.

# Choix de la période de calibration des données :
par(mfrow=c(1,1))
UK_ages = c(0,10,20,30,40,50,60,70,80,90,100)

plot(demogUK,
     series="female",
     datatype="rate", 
     plot.type="time",
     age = UK_ages,
     main="Taux de mortalité (1922 - 2021) ",axes = F)
# on fixe les axes comme suit :
axis(side = 1, at=1922:2021)

axis(side = 2, at=-10:0)
legend(x="bottomright", legend = UK_ages,
       col = rainbow(length(UK_ages)*1.25), lty = 1, cex=0.6,
       box.lwd = 0.3)

Mise à part l’age 0 le comportement des taux de mortalité reste constant durant toutes les années c’est pour ca qu’on va prendre en considération tous les années 1960 à 2021 ,t ∈ [1960, 2021]

# Choix de la plage d'âges:

x <- demogUK$age[0:110]
                         

plot(x, demogUK$rate$total[0:110,"1960"], 
     type='l', 
     col='red',
     xlab= "Ages x", 
     ylab="volatility", 
     ylim=c(0,1.5),
     main ="Volatilité du taux de mortalité (1960,2021)")

lines(x, demogUK$rate$total[0:110,"1960"], type = 'l', col="green" )

lines(x, demogUK$rate$total[0:110,"1970"], type = 'l', col='orange' )
lines(x, demogUK$rate$total[0:110,"1980"], type = 'l', col="blue" )

lines(x, demogUK$rate$total[0:110,"1990"], type = 'l', col="red" )
lines(x, demogUK$rate$total[0:110,"2000"], type = 'l', col='yellow' )

lines(x, demogUK$rate$total[0:110,"2010"], type = 'l', col="brown" )
lines(x, demogUK$rate$total[0:110,"2015"], type = 'l', col='pink' )

lines(x, demogUK$rate$total[0:110,"2021"], type = 'l', col="purple" )


legend(x="topleft", 
       legend = c("1960","1970","1980","1990","2000","2010","2015","2021"),
       col = c("red","green","orange","blue"), 
       lty = 1, 
       cex=0.6,
       box.lwd = 0.3)

faute d’une forte variabilité des taux de mortalité pour les âges > 100 on va se limiter à choisir x ∈ [0, 100].

#plage d'âges
ages.fit = 0:100
#période de calibration
years.fit = 1960:2021

# Lissage :
## 1- Spline monotone :
demogUK_ls_m <- smooth.demogdata(demogUK,method="mspline")

## 2- Spline standard :
demogUK_ls_s <- smooth.demogdata(demogUK, method="spline")

## 3- Spline Concave :
demogUK_ls_c <- smooth.demogdata(demogUK, method="cspline")

## 4- Spline localement quadratique :
demogUK_ls_q <- smooth.demogdata(demogUK, method="loess")

# comparaison :
plot(demogUK, years=2021, type="p", pch=21, ylim=c(-12, 0), main="UK: MT 2021 - Lissage")
lines(demogUK_ls_m, years=2021, lty=1, col="blue")

lines(demogUK_ls_s, years=2021, lty=2, col="red")
lines(demogUK_ls_c, years=2021, lty=3, col="green")

lines(demogUK_ls_q, years=2021, lty=4, col="black")
legend("topleft",col=c("blue","red","green","black") ,lty=1:4, leg=c("mspline", "spline","cspline","loess"))

===> mspline (lissage monotone) représente le mieux la variation du taux de mortalité

# fitting Lee Carter model :
# séparation des jeux des femmes :
lca.female <- lca(demogUK_ls_m, series="female", adjust="dt",years =years.fit ,ages = ages.fit)

#Paramètre ax:

plot(lca.female$ax, main="Coef. ax sur données britanniques", xlab="Age", ylab="ax", type="l",col="red")

legend("bottomright", c("Female"), cex=0.8,  lty=1:1 ,col="red")

Ce paramètre ax représente la tendance liée à l’effet isolé de l’âge sur les taux de mortalité des femmes(moyenne temporelle du logarithme du taux de mortalité par âge). Les courbes de ax suivent la tendance des courbes des données empiriques. Les âges faibles ont une décroissance jusqu’à atteindre un minimum absolu à de l’âge de 12 ans, puis une croissance exponentielle a partir de l’age de 60 ans .

Paramètre bx:

plot(lca.female$bx, main="Coef. bx sur données britanniques", ylim=c(0,0.03),xlab="Age", ylab="bx", type="l",col="blue")

legend("topright",c("Female"), cex=0.8,  lty=1:1,col="blue")

Le paramètre bx représentent l’interaction de l’effet des années calendaires sur les taux de mortalité. Cet effet est toujours positif mais la valeur ne cesse de diminuer avec l’âge. Autrement dit, l’effet des années calendaires agit majoritairement avant 50 ans et de moins en moins au delà. On constate une bosse à 22 ans et une bosse plus légère à 68 ans. Pour des âges élevés, l’effet est quasi-inexistant puisque bx est presque nul. C’est explicable grâce au fait que l’amélioration des conditions de vie et de la médecine ont diminué largement la mortalité infantile. De plus, chez les hommes, l’année a un plus grand effet que chez les femmes.

Ecart absolu des coefficients :

lca.total <- lca(demogUK_ls_m, series="total", adjust="dt",years =years.fit ,ages = ages.fit)
plot(lca.total$ax-lca.female$ax, main="Ecart avec population totale", xlab="Age x", ylab=expression(paste(Delta, " ax")), type="l" , col='green')
legend("topright",c("Female"), cex=0.8, lty=1:1)

On constate un plus grand écart de mortalité chez les femmes entre 20 et 30 ans que chez les hommes jusqu’à l’âge de 70 ans. La tendance s’inverse puisqu’au delà, l’écart de mortalité est plus grand pour les hommes.

Paramètre kt:

plot(lca.female$kt, xlab="Year", main="Coef. kt sur données britanniques",ylab="kt", type="l",ylim=c(-100, 100))
lines(lca.female$year, y=lca.female$kt, main="kt", lty=2 , col ="red")

legend("topright", c("Female"), cex=0.8, lty=1:1, col ="red")

La tendance à la baisse du coefficient “kt” suggère une amélioration générale de la longévité des femmes au Royaume-Uni au fil du temps. Cela a des implications pour les produits d’assurance vie et de retraite, car une longévité accrue peut signifier que les prestations doivent être payées plus longtemps que prévu

#total
plot(lca.total$residuals)

#female
plot(lca.female$residuals)

- intérprétation des résidus :

La variance instable des résidus pour les âges de 0 à 60 ans suggère que le modèle de Lee-Carter ne capture pas de manière adéquate la dynamique de la mortalité pour ce groupe d’âge.


Le modèle de Lee-Carter semble inadapté pour estimer les taux de mortalité des personnes âgées de moins de 60 ans. Cela souligne la nécessité d’explorer d’autres modèles ou facteurs pour mieux estimer la mortalité pour ce groupe d’âge.

RES=residuals(lca.female,"pearson")
colr=function(k) rainbow(110)[k*100]
couleur=Vectorize(colr)(seq(.01,1,by=.01))
plot(rep(RES$y,length(RES$x)),(RES$z),col=couleur[rep(RES$x,each=length(RES$y))-RES$x[1]+1])

plot(rep(RES$x,each=length(RES$y)),t(RES$z),col=couleur[rep(RES$y,length(RES$x))+1])

#en utilisant la fonction fit du package """StMoMo""" :
# Model de Lee Carter en utilisant le package """StMoMo""" 
# pour les paramétres éstimés on a les memes intérprétations

#install.packages("StMoMo")
library(StMoMo)

Le chargement a nécessité le package : gnm

#________________population féminine________________  :

UK.stmomo.f<-StMoMoData(data=demogUK_ls_m ,series = "female",type="central")
#ajustement du model (fitting) :
LC <- lc(link = "log" )
Lcfit <- fit(LC, data = central2initial(UK.stmomo.f), ages.fit = ages.fit,  years.fit = years.fit)

Avis dans fit.StMoMo(LC, data = central2initial(UK.stmomo.f), ages.fit = ages.fit,  :
  log-Poisson model fitted to initial exposure data

StMoMo: Start fitting with gnm
Initialising
Running start-up iterations..
Running main iterations.......
Done
StMoMo: Finish fitting with gnm

#names(Lcfit)
# paramétre ax :
plot(Lcfit$ax,type='l',col="red")

# paramétre bx ::
plot(Lcfit$bx,type='l',col="blue")

# paramétre kt :
plot(Lcfit$years,Lcfit$kt,type='l',col="green")

Le graphique montre une tendance générale à la baisse du coefficient “kt” du modèle de Lee-Carter, indiquant une amélioration continue de la longévité. Cependant, le pic observé de 2019 à 2021 reflète probablement l’impact significatif de la pandémie de COVID-19 sur les taux de mortalité.

# analyse desidusLelles :
LCres3 <- residuals(Lcfit)
plot(LCres3,type = "scatter") # Scatter plots of deviance residuals for models LC

Ce programme nous permet de simuler les trajectoires futures de l’échantillon à partir d’un modèle de mortalité stochastique, dans notre cas c’est le modèle Lee-Carter qui realise cette simulation. Par défaut, un ARIMA(1, 1, 0) avec une constante est utilisé dans ce programme.

Question 3 :

Simuler un nombre N= 5000 de trajectoires projetées sur 25 ans des taux de mortalité futurs à l’aide de la fonction simulate. • Décrire (en détail) ce que fait le programme. • Afficher les log taux de mortalités projetés pour la cohorte d’assurés, à partir de la date de début du contrat. • Afficher l’histogramme des espérances de vie cohorte à l’âge de 65 ans pour les cohortes d’individus ayant 65 ans en 2000 et 65 ans 2010, et pour la cohorte d’assurés. Commenter.

# Installer les packages nécessaires
install.packages("lifecontingencies")

Error in install.packages : Updating loaded packages

1)Simuler un nombre N= 5000 de trajectoires projetées sur 25 ans des taux de mortalité futurs à l’aide de la fonction simulate :

#Simulation of future mortality rates
N <- 5000 # Number of simulations
years.proj <- 2021:2046 # Projection years (next 25 years)
LCsim <- simulate(Lcfit, h = length(years.proj) , method = mean , nsim = N )

# Trouver l'index de l'année de début du contrat
start_year_index <- which(years.proj == 2021)
print(LCsim)

Simulations of Stochastic Mortality Model
Call: simulate.fitStMoMo(object = Lcfit, nsim = N, h = length(years.proj),  
Call:     method = mean)

Simulation based on
Call: fit.StMoMo(object = LC, data = central2initial(UK.stmomo.f),  
Call:     ages.fit = ages.fit, years.fit = years.fit)

kt model: mrwd
Jump-off method: fit
Years in simulation: 2022 - 2047
Ages in simulation: 0 - 100 

Number of paths: 5000 

2)Afficher les log taux de mortalités projetés pour la cohorte d’assurés, à partir de la date de début du contrat :

plot(Lcfit$years, (Lcfit$Dxt / Lcfit$Ext)["65", ], 
     xlim = range(Lcfit$years, LCsim$years),
     ylim = range((Lcfit$Dxt / Lcfit$Ext)["65", ], LCsim$rates["65", , ]), 
     type = "l", xlab = "year", ylab = "rate", 
     main = "Lee-Carter: Taux de mortalités simulés à partir de 2022")
matlines(LCsim$years, LCsim$rates["65", , ], type = "l", lty = 1)

Le graphique montre que les taux de mortalité simulés à partir de 2022, selon le modèle de Lee-Carter, présentent une variabilité croissante, reflétant l’incertitude inhérente à toute projection à long terme. Cependant, la tendance générale à la baisse de la mortalité semble se poursuivre.

library(fanplot)

probs = c(2.5, 10, 25, 50, 75, 90, 97.5)

qxt <- Lcfit$Dxt / Lcfit$Ext
matplot(Lcfit$years, t(qxt[c("65", "65", "65"), ]),
 xlim = c(1965, 2043), ylim = c(0.0025, 0.2), pch = 20, col = "black",
 log = "y", xlab = "year", ylab = "mortality rate (log scale)")
fan(t(LCsim$rates["65", , ]), start = 2022, probs = probs, n.fan = 4, fan.col = colorRampPalette(c("red", "white")), ln = NULL)

Le graphique montre les taux de mortalité (sur une échelle logarithmique) en fonction du temps. L’utilisation d’une échelle logarithmique permet de mieux visualiser les variations de taux de mortalité, en particulier lorsque les taux varient sur plusieurs ordres de grandeur.

Cependant, après 2022, le graphique montre une grande variabilité dans les taux de mortalité projetés. Cette variabilité, illustrée par la zone ombrée rouge, reflète l’incertitude inhérente à toute projection à long terme. Cette incertitude peut être due à des facteurs tels que les changements futurs dans les conditions de santé, les avancées médicales, les modes de vie et d’autres facteurs socio-économiques.

En conclusion, le passage à une échelle logarithmique permet de mieux visualiser et interpréter les tendances et les variations des taux de mortalité. Cependant, il est important de noter que toute projection à long terme comporte une certaine incertitude.

3)Afficher l’histogramme des espérances de vie cohorte à l’âge de 65 ans pour les cohortes d’individus ayant 65 ans en 2000 et 65 ans 2010, et pour la cohorte d’assurés :

tab<-read.table(file="fltper_1x1.txt", header = TRUE,skip=1, sep = "", dec = ".")
head(tab)

library(lifecontingencies)

##### année 2000 ######
UK_2000<- tab[which(tab$Year == 2000),names(tab)]
df_UK_2000<-data.frame(UK_2000)
df_UK_2000$Age<-as.numeric(as.character(df_UK_2000$Age))

Avis : NAs introduits lors de la conversion automatique

df_UK_2000$Age[111]<-110
TD_2000 <- new("lifetable", x=df_UK_2000$Age, lx= df_UK_2000$lx,name="UK")
ESP_2000=exn(TD_2000,x=65)
ESP_2000

[1] 18.37511

##### année 2010 ######
UK_2010<- tab[which(tab$Year == 2010),names(tab)]
df_UK_2010<-data.frame(UK_2010)
df_UK_2010$Age<-as.numeric(as.character(df_UK_2010$Age))

Avis : NAs introduits lors de la conversion automatique

df_UK_2010$Age[111]<-110
TD_2010 <- new("lifetable", x=df_UK_2010$Age, lx= df_UK_2010$lx,name="UK")
ESP_2010=exn(TD_2010,x=65)
ESP_2010

[1] 20.07817

##### la cohorte de toutes les assures d’assurés ######
bar <- subset(tab, Age == 65)
esp_totale=mean(bar$ex)
esp_totale

[1] 16.4106

#### Histograme #####
kk=c(ESP_2000,ESP_2010,esp_totale)
barplot(kk,
main = "Esperances de vie",
xlab = "Esperance ",
ylab = "Age",
names.arg = c("2000","2010","Total"),
col = "darkred",
horiz = FALSE)

D’après le graphique, l’espérance de vie à 65 ans a augmenté de 2000 à 2010. Cette amélioration peut être attribuée à des facteurs tels que les progrès médicaux, une meilleure nutrition et des modes de vie plus sains.

Question 4 :

Créer une fonction R calculant la valeur actuelle probable de la rente viagère à terme anticipé, étant donnée une liste de taux de mortalité

FemaleUK<-read.table(file="fltper_1x1.txt", header = TRUE,skip=1, sep = "", dec = ".")


VAP=function(x,tab,i, year){
        UK_annee<- tab[which(tab$Year == year),names(tab)]
        df_UK_annee<-data.frame(UK_annee)
        df_UK_annee$Age<-as.numeric(as.character(df_UK_annee$Age))
        df_UK_annee$Age[111]<-110
        TD_annee <- new("lifetable", x=df_UK_annee$Age, lx= df_UK_annee$lx,name="UK")
        VAP_f = axn(TD_annee, x=x, i=i,n=25)
        
        return(VAP_f)
}
#Test de la fonction 
print(VAP(60,FemaleUK,0.03,1960))

Cette fonction est utile car elle permet de calculer la valeur actuelle d’une série de paiements futurs (c’est-à-dire une rente) en tenant compte de la mortalité. Cela est crucial pour la tarification des produits d’assurance vie et de retraite, car cela permet aux actuaires de déterminer combien une compagnie d’assurance ou un régime de retraite doit mettre de côté aujourd’hui pour être en mesure de faire ces paiements futurs.

Avis dans VAP(60, FemaleUK, 0.03, 1960) :
  NAs introduits lors de la conversion automatique

[1] 13.86076

Question 5 :

Calculer la VAP du contrat pour chacun des scénarios de mortalité générés à la question précédente. Donner la valeur moyenne obtenue et sa variance. Proposer une tarification

VAP_scenario1=VAP(65,FemaleUK,0.03,2000)

Avis dans VAP(65, FemaleUK, 0.03, 2000) :
  NAs introduits lors de la conversion automatique

VAP_scenario2=VAP(65,FemaleUK,0.03,2010)

Avis dans VAP(65, FemaleUK, 0.03, 2010) :
  NAs introduits lors de la conversion automatique

c(VAP_scenario1,VAP_scenario2)

[1] 13.81125 14.58216

mean(c(VAP_scenario1,VAP_scenario2))

[1] 14.1967

sd(c(VAP_scenario1,VAP_scenario2))

[1] 0.5451168

En comparant les résultats de la VAP pour les années 2000 et 2010, on peut observer une augmentation de la VAP. Cela suggère que l’espérance de vie à 65 ans a augmenté entre 2000 et 2010.

Tarification : les taux de notre cohorte des individus nées en 1960 :

library(demography)

chosen_cohort=1960
lc_historical_rates <- extractCohort(fitted(Lcfit, type = "rates"), cohort = chosen_cohort)
                                    
lc_sim_rates <- extractCohort(LCsim$rates,cohort = chosen_cohort)
                                     
lc_rates_1960 <- c(lc_historical_rates,lc_sim_rates)

lc_qx_1960 <-mx2qx(lc_rates_1960)


#transformation actuarial table en lifetable:
lc_lifetable_1960 <- probs2lifetable(probs=lc_qx_1960,type = "qx", name = paste("LC","1960","lt",sep="_"))

lc_acttbl_1960<-new("actuarialtable",x=lc_lifetable_1960@x,lx=lc_lifetable_1960@lx)

VAP_hist_projet = axn(lc_acttbl_1960, x=60, n=25) # on a projeté que 25 ans selon le question "3"
VAP_hist_projet

[1] 16.02708

Prime_Propose = axn(lc_acttbl_1960, x=60, m=25)/axn(lc_acttbl_1960, x=60, m=1,n=25) 
Prime_Propose

[1] 0.3626834

La prime proposée est calculée comme le ratio de la VAP sur la valeur actuelle de l’unité de rente payable annuellement pendant 25 ans.

Question 6 :

Quelles sont les autres sources d’incertitudes ?

La VAP dépend de deux facteurs qui sont l’âge de l’assuré et l’interet i

Par rapport à l’âge la VAP croit en fonction de l’âge (corrélation positive) vu que la probabilité de décès augmente en fonction de ce dernier .

Par rapport à l’interet: La VAP est sensible aux taux d’intérêt. Si les taux d’intérêt futurs sont différents de ceux supposés lors du calcul de la VAP, la valeur réelle des paiements de la rente pourrait être différente de la VAP.